MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 06 - 1990/06.07 Jul 90/Data Exchange ƒ/Listing7.T

Text File | 1989-04-24 | 15.1 KB | 670 lines | [TEXT/MPS ]

MODULE FixPObj;
(*
   Go through an object code file and change dictionary occurrences of one
string to another string.  The default behavior is to change "QUICKDRAW" to
"QuickDraw__Globals" which makes code generated by the Pascal compiler
compatible with code generated by the Modula compiler.
   This utility can handle MPW object file formats 1 through 3 (MPW 2.0 and
3.0).  If it is used on a later object file it will emit a warning message.

   Arguments:
              --Input file name is required.
                 --Output file name may be specified with '-o' option, otherwise
                   a default output name of FixP.o will be used. The output file
                    name must be different from the input file name.
                 --Strings for substitution may be specified with the '-s' option.
                    i.e., "-s QUICKDRAW=QuickDraw__Globals" would specify the default
                    behavior.

      9/20/88
           --Written by John N. Calley
        4/24/89 JNC
           --Updated for MPW 3.0 object file formats
            --Fixed CAP bug that prevented recognition of options
            --Added spinning MPW cursor

*)
FROM CursorControl IMPORT
   (*procs*) SpinCursor;
FROM Diagnostic IMPORT
   (*procs*) WriteString, WriteCard, WriteLongInt, WriteInt,
              WriteLn;
FROM FileManager IMPORT
   (*types*) FInfo,
    (*procs*) GetFInfo, SetFInfo;
FROM IntEnv IMPORT
   (*vars *) ArgC, ArgV, Exit;
FROM IntEnvIO IMPORT
   (*const*) InputFD, OutputFD, RDONLY, WRONLY, CREAT, TRUNC,
    (*procs*) ErrNo, open, read, write, close;
FROM MacTypes IMPORT
   (*types*) Str255, StringHandle, OSErr;
FROM MemoryManager IMPORT
   (*procs*) NewHandle, DisposHandle, HLock, HUnlock;
FROM Strings IMPORT
   (*procs*) Length, MakePascalString, Copy, Pos;
FROM SYSTEM IMPORT
   (*types*) ADDRESS,
   (*procs*) VAL, SHIFT, ADR, LONG;
FROM Utilities IMPORT
   (*procs*) Munger;

CONST
   defaultOutFile = "FixP.o";
    latestVersion = 3;   (* latest version of Obj file format understood *)
   pp = FALSE;          (* print progress information *)

VAR
    inFileName,
    outFileName,
    inString,
    outString
       :Str255;

    inFile,       (* File IDs for input and output files *)
    outFile,
    status        (* Status of last read or write operation *)
       :LONGINT;


PROCEDURE PrintUsage();
(*
   Print usage statement.
*)
BEGIN
   WriteString ("# ");
   WriteString (ArgV^[0]^);
   WriteString (": Bad option or unable to open file.");
    WriteLn();
   WriteString ("# Usage: ");
   WriteString (ArgV^[0]^);
   WriteString (" [-s oldString=newString] [-o outFileName] inFileName");
    WriteLn();
END PrintUsage;

PROCEDURE SetOptions():BOOLEAN;
(*
   Set up input file name, optional output file name and optional string substitutions.  Return
TRUE if all options are interpretable, FALSE if there is an unrecognizable option or if no
input file name is given.
*)
VAR
    i, j
       :INTEGER;
   tempLength
      :INTEGER;
    optionsOK
       :BOOLEAN;
    equalPos        (* Position of '=' in substitution option *)
       :INTEGER;
BEGIN
(* Set defaults *)
   inFileName := "";
    outFileName := defaultOutFile;
    inString := "QUICKDRAW";   (* default substitutions *)
    outString := "QuickDraw__Globals";
   optionsOK := TRUE;
    i := 1;
    WHILE i < ArgC DO
      IF ArgV^[i]^[0] = '-' THEN
            IF CAP(ArgV^[i]^[1]) = "O" THEN
                INC(i);  (* next argument should be output file name *)
                outFileName := VAL(Str255, ArgV^[i]^);
            ELSIF CAP(ArgV^[i]^[1]) = "S" THEN
               INC(i);  (* next argument shoud be set of substitution strings *)
                equalPos := Pos ("=", ArgV^[i]^);
                IF equalPos = -1 THEN
                   optionsOK := FALSE;
                    WriteString ("No = sign");
                ELSE
                   Copy (ArgV^[i]^, 0, equalPos, inString);
                    Copy (ArgV^[i]^, equalPos + 1,
                                     VAL(INTEGER, Length(ArgV^[i]^)) - equalPos,
                                     outString);
                END; (*IF*)
            ELSE (* Unknown '-' option *)
                optionsOK := FALSE;
                WriteString ("Unknown -");
            END; (*IF*)
        ELSE (* We assume it is the input file name *)
           inFileName := VAL(Str255, ArgV^[i]^);
       END; (*IF*)
        INC(i);
    END; (*WHILE*)
    RETURN (optionsOK);
END SetOptions;

PROCEDURE OpenFiles():BOOLEAN;
(*
   Open the files indicated by <inFileName> and <outFileName>. Return TRUE if the operations
are successful, FALSE otherwise.
*)
VAR
   success
       :BOOLEAN;

BEGIN
   success := TRUE;
    IF Length(inFileName) = 0 THEN
       success := FALSE;
    ELSE
       inFile := open (inFileName, RDONLY);
        IF ErrNo() <> 0D THEN
           success := FALSE;
        END; (*IF*)
    END; (*IF*)
   IF Length(outFileName) = 0 THEN
       outFile := OutputFD;   (* Standard output *)
    ELSE
       outFile := open (outFileName, WRONLY + CREAT + TRUNC);
        IF ErrNo() <> 0D THEN
           success := FALSE;
        END; (*IF*)
    END; (*IF*)
    RETURN (success);
END OpenFiles;


PROCEDURE ReadWord (VAR value:CARDINAL);
(*
   Read the next two characters as a binary value and return that value.
*)
BEGIN
   status := read (inFile, ADR(value), 2D);
END ReadWord;

PROCEDURE WriteWord (value:CARDINAL);
(*
   Write out the indicated integer as two consecutive bytes.
*)
BEGIN
   status := write (outFile, ADR(value), 2D);
END WriteWord;

PROCEDURE WriteByte (value:INTEGER);
(*
   Write out the low byte of the indicated integer.
*)
BEGIN
   status := write (outFile, ADR(value) + 1D, 1D);
END WriteByte;

PROCEDURE ReadByte ():CHAR;
(*
   Read in one byte and return it as a character
*)
VAR
    tempChar
       :CHAR;
BEGIN
   status := read (inFile, ADR(tempChar), 1D);
    RETURN (tempChar);
END ReadByte;

PROCEDURE Pass (length:CARDINAL);
(*
   Pass through the indicated number of bytes from input to output.
*)
VAR
   tempStr
       :Str255;
    tempLength
       :CARDINAL;
BEGIN
   WHILE length > 0 DO
       IF length > 256 THEN
           tempLength := 256;
            DEC(length, 256);
        ELSE
           tempLength := length;
            length := 0;
        END; (*IF*)
        status := read (inFile, ADR(tempStr), LONG(tempLength));
        status := write (outFile, ADR(tempStr), LONG(tempLength));
    END; (*WHILE*)
END Pass;

PROCEDURE ReadString (VAR string:Str255; VAR length:INTEGER);
(*
   Read the pascal formatted string from the input and return it in <string>.
<length> is the length of the returned string.
*)
VAR
    inChar
       :CHAR;
BEGIN
   status := read (inFile, ADR(inChar), 1D);
    length := VAL(INTEGER, inChar);
    status := read (inFile, ADR(string), LONG(length));
    string[length] := VAL(CHAR, 0);  (* null terminate the string *)
END ReadString;

PROCEDURE WritePString (string:Str255);
(*
   Write out the indicated string in pascal format.
*)
VAR
   tempStr
       :Str255;
BEGIN
   MakePascalString (string, tempStr);
    status := write (outFile, ADR(tempStr), LONG(VAL(INTEGER, tempStr[0]) + 1));
END WritePString;

PROCEDURE ProcessFirst();
(*
   Pass a First record through. Print a warning if the version number is later
that the latest we know about (1).
*)
VAR
    version
       :CARDINAL;
BEGIN
   IF pp THEN
        WriteString ("First");
        WriteLn();
    END; (*IF*)
    WriteByte (1);
    Pass (1);
    ReadWord (version);
    WriteWord (version);
    IF version > latestVersion THEN
       WriteString ("# Warning: Unknown object file format version. ");
        WriteLn();
        WriteString ("# Output may not be correct.");
        WriteLn();
    END; (*IF*)
END ProcessFirst;

PROCEDURE ProcessLast();
(*
   Pass a Last record through.
*)
BEGIN
   IF pp THEN
        WriteString ("Last");
        WriteLn();
    END; (*IF*)
    WriteByte (2);
    Pass (1);
END ProcessLast;

PROCEDURE ProcessComment();
(*
   Pass a comment record on through.
*)
VAR
    size
       :CARDINAL;
BEGIN
   IF pp THEN
       WriteString ("Comment record");
        WriteLn();
    END; (*IF*)
    WriteByte (3);
    Pass (1);
    ReadWord (size);
    WriteWord (size);
    Pass (size - 4);
END ProcessComment;

PROCEDURE ReadDict (dict:StringHandle; length:LONGINT);
(*
   Read <length> bytes from standard input into the handle <dict>.
*)
BEGIN
   HLock (dict);
    status := read (inFile, dict^, length);
   HUnlock (dict);
END ReadDict;

PROCEDURE ModifyDict (dict:StringHandle):BOOLEAN;
(*
   Substitute <outString> for the string <inString> in <dict>.  There will not be more
that one occurrence.
   Return TRUE if a replacement was done, FALSE if no replacement occurred.
*)
VAR
   pInString,   (* <inString> and <outString> are modula strings, we actually need *)
    pOutString   (* to replace pascal format strings. *)
       :Str255;
    result
       :LONGINT;
BEGIN
   MakePascalString (inString, pInString);
    MakePascalString (outString, pOutString);
    result := Munger (dict, 2, ADR(pInString), LONG(VAL(INTEGER, pInString[0]) + 1),
                               ADR(pOutString), LONG(VAL(INTEGER, pOutString[0]) + 1));
    IF result > 0D THEN
       RETURN(TRUE);
    ELSE
       RETURN(FALSE);
    END; (*IF*)
END ModifyDict;

PROCEDURE WriteDict (dict:StringHandle; length:LONGINT);
(*
   Write <length> bytes from <dict> to standard output.
*)
BEGIN
   HLock (dict);
    status := write (outFile, dict^, length);
   HUnlock (dict);
END WriteDict;

PROCEDURE ProcessDict();
(*
   Process a dictionary record. If the record defines the string <inString> then replace it
with the string <outString> and write out the modified dictionary record.  If it does not
contain <inString> write it out unchanged.

   Method:
       Find out what the current length of the record is.
        Allocate a handle that is large enough for the record after the string has been changed.
        Read the record into the handle.
        Use Munger to perform the substitution if any.
        Write the potentially modified record back out.
*)
VAR
   inChar
       :CHAR;
    length      (* length of the dictionary record *)
       :CARDINAL;
    wasOdd      (* TRUE if the original dictionary record had an odd length *)
       :BOOLEAN;
    dict
       :StringHandle;
BEGIN
   IF pp THEN
        WriteString ("Dictionary");
        WriteLn();
    END; (*IF*)
   inChar := ReadByte();     (* This byte should always be 0 *)
    ReadWord (length); (* length of the dictionary record *)
    IF pp THEN
        WriteString ("Dictionary length is ");
        WriteCard (length, 4);
        WriteLn();
    END; (*IF*)
    wasOdd := ODD(length);
    dict := NewHandle (length + Length(outString));
    length := length - 4;  (* Compensate for the fact that we have already read 4 bytes of header*)
    ReadDict (dict, length);   (* Read the dictionary into the <dict> handle *)
    IF ModifyDict (dict) THEN
       IF pp THEN
            WriteString ("Changed: Old length = ");
            WriteCard (length, 4);
        END; (*IF*)
       length := length + Length(outString) - Length(inString);
        IF pp THEN
            WriteString ("  outString = '");
            WriteString (outString);
            WriteString ("'  length = '");
            WriteCard (Length(outString), 4);
            WriteString ("  inString = '");
            WriteString (inString);
            WriteString ("'  length = '");
            WriteCard (Length(inString), 4);
            WriteLn();
            WriteString ("  New Dictionary length = ");
            WriteCard (length, 4);
            WriteLn();
        END; (*IF*)
    END;
    WriteByte (4);
    WriteByte (0);
    WriteWord (length + 4);
    WriteDict (dict, length);
    IF NOT (wasOdd = ODD(length)) THEN
       WriteByte (0);   (* Write a pad record *)
    END; (*IF*)
    DisposHandle (dict);
END ProcessDict;

PROCEDURE ProcessPad();
(*
   Acknowledge that a padding record has been read.
*)
BEGIN
   WriteByte (0);
   IF pp THEN
        WriteString ("Pad");
        WriteLn();
    END; (*IF*)
END ProcessPad;

PROCEDURE ProcessDataModule();
(*
   Pass a data module record on through.
*)
VAR
   moduleID,
    size
       :CARDINAL;
BEGIN
   ReadWord (moduleID);
    WriteWord (moduleID);
    ReadWord (size);
    WriteWord (size);
    IF pp THEN
        WriteString ("Data Module: ");
        WriteCard (moduleID, 4);
        WriteString ("size is ");
        WriteCard (size, 4);
        WriteLn();
    END; (*IF*)
END ProcessDataModule;

PROCEDURE ProcessCodeModule();
(*
   Pass a code module record on through.
*)
VAR
   moduleID,
    segID
       :CARDINAL;
BEGIN
   ReadWord (moduleID);
    WriteWord (moduleID);
    ReadWord (segID);
    WriteWord (segID);
    IF pp THEN
        WriteString ("Code Module: ");
        WriteCard (moduleID, 4);
        WriteString (" seg ID:");
        WriteCard (segID, 4);
        WriteLn();
    END; (*IF*)
END ProcessCodeModule;

PROCEDURE ProcessModule();
(*
   Pass a module record on through.
*)
VAR
    inChar
        :CHAR;
    flags
        :INTEGER;

BEGIN
   WriteByte (5);
   inChar := ReadByte (); (*flags*)
    flags := VAL(INTEGER, inChar);
    WriteByte (flags);
    IF ODD(flags) THEN
       ProcessDataModule();
    ELSE
       ProcessCodeModule();
    END; (*IF*)
END ProcessModule;

PROCEDURE ProcessEntryPoint();
(*
   Pass an entry point record on through.
*)
BEGIN
   WriteByte (6);
    Pass (7);
    IF pp THEN
        WriteString ("Entry Point");
        WriteLn();
    END; (*IF*)
END ProcessEntryPoint;

PROCEDURE ProcessSize();
(*
   Pass a size record on through.
*)
BEGIN
   WriteByte (7);
    Pass (5);
END ProcessSize;

PROCEDURE ProcessContents();
(*
   Pass a contents record on through.
*)
VAR
    size          (* Size of the contents record *)
       :CARDINAL;
BEGIN
   WriteByte (8);
    Pass (1);       (* flags *)
    ReadWord (size);
    WriteWord (size);
    IF pp THEN
        WriteString ("Contents:   size=");
        WriteCard (size, 4);
        WriteLn();
    END; (*IF*)
    Pass (size - 4);
END ProcessContents;

PROCEDURE ProcessReference ();
(*
   Pass a reference record on through.
*)
VAR
    size
       :CARDINAL;
BEGIN
   WriteByte (9);
   IF pp THEN
        WriteString ("Reference Record");
        WriteLn();
    END; (*IF*)
    Pass (1);      (* flags *)
    ReadWord (size);
    WriteWord (size);
    Pass (size - 4);
END ProcessReference;

PROCEDURE ProcessCReference ();
(*
   Pass a computed reference record on through.
*)
VAR
    size
       :CARDINAL;
BEGIN
   WriteByte (10);
    IF pp THEN
        WriteString ("Computed Reference Record");
        WriteLn();
    END; (*IF*)
    Pass (1);      (* flags *)
    ReadWord (size);
    WriteWord (size);
    Pass (size - 4);
END ProcessCReference;

PROCEDURE ProcessSymbolic (type:INTEGER);
(*
   Pass a symbolic record on through to the output.
*)
VAR
   size
       :CARDINAL;
BEGIN
   WriteByte (type);
    IF pp THEN
       WriteString ("Symbolic Record: type ");
        WriteInt (type, 1);
        WriteLn();
    END; (*IF*)
    Pass (1); (* flags *)
    ReadWord (size);
    WriteWord (size);
    Pass (size - 4);  (* Body of record data *)
END ProcessSymbolic;

PROCEDURE Dispatch (inChar:CHAR);
(*
   Decide who should process this and dispatch control to them.
*)
VAR
   type
       :INTEGER;

BEGIN
   type := VAL(INTEGER, inChar);
   CASE type OF
       0 :ProcessPad();                 |
       1 :ProcessFirst();               |
        2 :ProcessLast();                |
        3 :ProcessComment();             |
        4 :ProcessDict();                |
        5 :ProcessModule();              |
        6 :ProcessEntryPoint();          |
        7 :ProcessSize();                |
        8 :ProcessContents();            |
        9 :ProcessReference();           |
        10:ProcessCReference();          |
    (* Symbolic Records for MPW 3.0 *)
       11..19:ProcessSymbolic(type);    |
        ELSE
           (*
               This happens when the byte past the last byte of the file is read.
               Ignore it.
            *)
    END; (*CASE*)
END Dispatch;

PROCEDURE SetOutFileType();
(*
   We created a text file, we need to make it into an OBJ file so that
the linker will accept it.
*)

VAR
   fInfo
       :FInfo;
    err
       :INTEGER;
BEGIN
    err := GetFInfo (outFileName, 0, fInfo);
    IF err = 0 THEN
        fInfo.fdType := 'OBJ ';
        err := SetFInfo (outFileName, 0, fInfo);
    END; (*IF*)
    IF err <> 0 THEN
        WriteString ("# Problem setting output file type to 'OBJ '");
        WriteLn();
    END; (*IF*)
END SetOutFileType;

BEGIN (*Main*)
   IF SetOptions() AND OpenFiles() THEN
        REPEAT
           SpinCursor (1);
            Dispatch (ReadByte());
        UNTIL status = 0D;
        SetOutFileType();
        Exit (0D);
    ELSE
       PrintUsage();
        Exit (1D);
    END; (*IF*)
END FixPObj.